home *** CD-ROM | disk | FTP | other *** search
/ The Programmer Disk / The Programmer Disk (Microforum).iso / xpro / qb2 / pro15 / put-1.bas < prev    next >
Encoding:
BASIC Source File  |  1990-08-20  |  5.3 KB  |  236 lines
  1.  '******************************************************************************
  2.  '* PUT-1 - 'Put' function demo.                                               *
  3.  '*                                                                            *
  4.  '* Written for GRAFIX by:  Joseph A. Albrecht                                 *
  5.  '*                                                                            *
  6.  '* Press F10 to toggle between 320 and 640 graphic modes                      *
  7.  '* Press ESC to exit program                                                  *
  8.  '******************************************************************************
  9.  '$INCLUDE: 'GRAFQBS.INC' 
  10.  'The above line is for QuickBASIC.
  11.  
  12.  ''$INCLUDE "GRAFTBS.INC"
  13.  'The above line is for TURBO BASIC. Remove the  ''  to compile the program.
  14.  
  15.  ''$INCLUDE "GRAFPBS.INC"
  16.  'The above line is for PowerBASIC. Remove the  ''  to compile the program.
  17.  
  18.  DIM Box(138), C$(15), M$(5)
  19.  
  20.  FOR N = 0 TO 15
  21.    READ C$(N)
  22.  NEXT N
  23.  FOR N = 1 TO 5
  24.    READ M$(N)
  25.  NEXT N
  26.  
  27.  Graphics = 320
  28.  BoxStep = 48
  29.  BoxWidth = 31
  30.  CALL GetTandy11(Tandy11%)
  31.  CALL MediumGraphics
  32.  
  33. Again:
  34.  CALL ClearScreen
  35.  CALL SetTextColor(Yellow)
  36.  GOSUB DrawBoxes
  37.  CALL SetTextColor(Brown)
  38.  CALL SetCursor(5, 5)
  39.  CALL PrintString("ACTION:")
  40.  FOR N = 1 TO 5
  41.    GOSUB PrintNames
  42.  NEXT N
  43.  CALL SetTextColor(LightCyan)
  44.  CALL PrintString(" ")
  45.  CALL PrintString(" Enter number " + CHR$(24))
  46.  CALL PrintString(" ")
  47.  CALL PrintString("       or")
  48.  CALL PrintString(" ")
  49.  CALL PrintString(" press <Return>")
  50.  CALL PrintString(" ")
  51.  CALL PrintStringX(" for next color")
  52.  
  53. MainLoop:
  54.  CALL SetTextColor(Yellow)
  55.  CALL SetCursor(2, 1)
  56.  CALL PrintStringX(SPACE$(16))
  57.  CALL SetCursor(2, 2)
  58.  CALL PrintStringX("Color (0-F) ")
  59.  C = -1
  60.  CALL ClearKey
  61.  WHILE C < 0 OR C > 15
  62.    A$ = INKEY$
  63.    A$ = RIGHT$(A$, 1)
  64.    IF A$ = CHR$(68) THEN GOSUB SwitchGraphics
  65.    A$ = UCASE$(A$)
  66.    SELECT CASE A$
  67.      CASE "A" TO "F"
  68.        C = ASC(A$) - 55
  69.      CASE "0" TO "9"
  70.        C = ASC(A$) - 48
  71.      CASE CHR$(27)
  72.        GOTO EndProgram
  73.      CASE ELSE
  74.        C = -1
  75.    END SELECT
  76.  WEND
  77.  CALL SetCursor(2, 1)
  78.  CALL PrintStringX(SPACE$(16))
  79.  GOSUB DrawBoxes
  80.  IF Graphics = 320 THEN
  81.    CALL FillBox(0, 0, 15, 15, C)
  82.    CALL ExtGet(0, 0, 15, 15, Box(0))
  83.    CALL ExtPut(0, 0, Box(0), PutXor)
  84.  ELSE
  85.    CALL FillBox(0, 0, 30, 15, C)
  86.    CALL ExtGet(0, 0, 30, 15, Box(0))
  87.    CALL ExtPut(0, 0, Box(0), PutXor)
  88.  END IF
  89.  IF C = 0 THEN
  90.    CALL SetTextColor(DarkGray)
  91.  ELSE
  92.    CALL SetTextColor(C)
  93.  END IF
  94.  CALL SetCursor(2, (8 - LEN(C$(C)) \ 2))
  95.  CALL PrintStringX(C$(C))
  96.  CALL ClearKey
  97.  
  98.  N = 0
  99.  DO UNTIL N >= 1 AND N <= 5
  100.    A$ = ""
  101.    WHILE A$ = ""
  102.      A$ = INKEY$
  103.    WEND
  104.    A$ = RIGHT$(A$, 1)
  105.    N = VAL(A$)
  106.    IF A$ = CHR$(13) THEN GOTO NextAction
  107.    IF A$ = CHR$(27) THEN GOTO EndProgram
  108.    IF A$ = CHR$(68) THEN GOSUB SwitchGraphics
  109.  LOOP
  110.  
  111. NextAction:
  112.  IF A$ = CHR$(13) THEN
  113.    CALL SetCursor(2, 3)
  114.    CALL PrintStringX(SPACE$(10))
  115.    GOTO MainLoop
  116.  END IF
  117.  CALL SetTextColor(Yellow)
  118.  FOR B = 1 TO 3
  119.    CALL SetCursor(N * 2 + 6, 2)
  120.    CALL PrintStringX(SPACE$(14))
  121.    CALL Pause(8)
  122.    GOSUB PrintNames
  123.    CALL Pause(8)
  124.  NEXT B
  125.  IF Graphics = 320 THEN X1 = 145 ELSE X1 = 188
  126.  X = X1
  127.  Y = 20
  128.  K = 0
  129.  FOR I = 1 TO 4
  130.    FOR J = 1 TO 4
  131.      ON N GOSUB ShowPreset, ShowPset, ShowAnd, ShowOr, ShowXor
  132.       X = X + BoxStep
  133.       K = K + 1
  134.    NEXT J
  135.      X = X1
  136.      Y = Y + 48
  137.  NEXT I
  138.  M = 0
  139.  DO UNTIL M >= 1 AND M <= 5
  140.    A$ = ""
  141.    WHILE A$ = ""
  142.      A$ = INKEY$
  143.    WEND
  144.    A$ = RIGHT$(A$, 1)
  145.    M = VAL(A$)
  146.    IF A$ = CHR$(13) THEN GOTO NextAction1
  147.    IF A$ = CHR$(27) THEN GOTO EndProgram
  148.    IF A$ = CHR$(68) THEN GOSUB SwitchGraphics
  149.  LOOP
  150.  
  151. NextAction1:
  152.  CALL SetTextColor(Brown)
  153.  GOSUB PrintNames
  154.  GOSUB DrawBoxes
  155.  N = M
  156.  GOTO NextAction
  157.  
  158. ShowPreset:
  159.  CALL ExtPut(X, Y, Box(0), PutPreset)
  160.  RETURN
  161.  
  162. ShowPset:
  163.  CALL ExtPut(X, Y, Box(0), PutPset)
  164.  RETURN
  165.  
  166. ShowAnd:
  167.  CALL ExtPut(X, Y, Box(0), PutAnd)
  168.  RETURN
  169.  
  170. ShowOr:
  171.  CALL ExtPut(X, Y, Box(0), PutOr)
  172.  RETURN
  173.  
  174. ShowXor:
  175.  CALL ExtPut(X, Y, Box(0), PutXor)
  176.  RETURN
  177.  
  178. PrintNames:
  179.  CALL SetCursor(N * 2 + 6, 2)
  180.  CALL PrintStringX(M$(N))
  181.  FOR P = 1 TO 12 - LEN(M$(N))
  182.    CALL PrintStringX(".")
  183.  NEXT P
  184.  CALL PrintString(STR$(N))
  185.  RETURN
  186.  
  187. DrawBoxes:
  188.  IF Graphics = 320 THEN
  189.    CALL FillBox(129, 4, 319, 195, Black)
  190.    CALL DrawBox(129, 4, 319, 195, Red)
  191.  ELSE
  192.    CALL FillBox(129, 4, 639, 195, Black)
  193.    CALL DrawBox(129, 4, 639, 195, Red)
  194.  END IF
  195.  CALL SetPlotColor(Red)
  196.  CALL ExtLine(4, 24, 124, 24)
  197.  IF Graphics = 320 THEN X1 = 137 ELSE X1 = 172
  198.  X = X1
  199.  Y = 12
  200.  K = 0
  201.  FOR I = 1 TO 4
  202.    FOR J = 1 TO 4
  203.      CALL FillBox(X, Y, X + BoxWidth, Y + 31, K)
  204.      IF K = 0 THEN CALL DrawBox(X, Y, X + BoxWidth, Y + 31, DarkGray)
  205.      X = X + BoxStep
  206.      K = K + 1
  207.    NEXT J
  208.    X = X1
  209.    Y = Y + 48
  210.  NEXT I
  211.  RETURN
  212.  
  213. SwitchGraphics:
  214.   IF Tandy11% = Tandy11.False% THEN RETURN
  215.   IF Graphics = 320 THEN
  216.     Graphics = 640
  217.     BoxStep = 120
  218.     BoxWidth = 62
  219.     CALL HighGraphics
  220.     RETURN Again
  221.   ELSE
  222.     Graphics = 320
  223.     BoxStep = 48
  224.     BoxWidth = 31
  225.     CALL MediumGraphics
  226.     RETURN Again
  227.   END IF
  228.  
  229. EndProgram:
  230.  CALL ExitGraphics
  231.  END
  232.  
  233.  DATA BLACK,BLUE,GREEN,CYAN,RED,MAGENTA,BROWN,LT GREY,GREY
  234.  DATA LT BLUE,LT GREEN,LT CYAN,LT RED,LT MAGENTA,YELLOW,WHITE
  235.  DATA PRESET,PSET,AND,OR,XOR
  236.